home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / hardware / gm1507 / g_mouse.pas < prev    next >
Pascal/Delphi Source File  |  1994-10-27  |  25KB  |  1,041 lines
  1. { --------------------------------------------------------------------------- }
  2. { G_MOUSE.PAS  g_Mouse Interface Unit - graphical mouse pointer in text mode  }
  3. {             80x25. Borland Pascal 7 version. Supports both real and protec- }
  4. {             ted modes.                                                      }
  5. {                                          }
  6. {                                   Version 1.50.7 }
  7. {                              Written by Bobby Z. }
  8. {                       Copyright(c) 1993,94 by B-coolWare }
  9. { --------------------------------------------------------------------------- }
  10. { 
  11.                                       "Nice, nice. Not excellent, but nice..."
  12.  
  13.                                 (Mel Brooks)
  14.  
  15.   License.
  16.   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  17.  
  18.  SOFTWARE STATUS:
  19.  
  20.  This software is copyrighted free one. This means that it is distributed
  21.   free of charge and that you must keep copyright notice with it. Usually this
  22.   also means that you cannot modify the code, but it is not the case with
  23.   this one (see grant of license for details). Note that it is not public
  24.   domain software, that is author reserves copyright for it as well as some
  25.   other rights.
  26.  
  27.  GRANT OF LICENSE:
  28.  
  29.  You are hereby granted the right to use this software in either commercial
  30.   or non-commercial products provided that you do not charge any extra fee
  31.   for this code and that you keep copyright notice unchanged. 
  32.  You are also granted the right to distribute this code freely in its original
  33.   unmodified form provided that you do not charge any fee that exceed your
  34.   expences from distributing it (for example, uploading to commercial network).
  35.  You also may modify the code to add new features or eliminate bugs or
  36.   incompatibilites you discovered and distribute modified code provided that
  37.   you add a notice that the code was modified. If you do any modifications
  38.   to the code, please send me modified version so that I'll be able to
  39.   reflect changes in the next releases. Regardless of the extent of modifica-
  40.   tions the code should remain free and will still copyright(c) by B-coolWare. 
  41.  If you break any of the rules mentioned you'll be liable for violation of
  42.   Russian Copyright Law in Computer Programs and Databases as well as other
  43.   national or international laws and treaties. The parties that acquired this
  44.   code from you will still have their rights as long as they comply with this
  45.   license.
  46.  
  47.  DISCLAIMER:
  48.  
  49.  Author disclaims all warranties, whether express or implied, of code quality,
  50.   reliability or fitness for a particular purpose. I can only guarantee that it
  51.   will occupy disk space. Though this code was thoroughly tested, the possibi-
  52.   lity of errors can't be eliminated. Do not blame me if something goes wrong -
  53.   you were warned.
  54.  
  55.  AUTHOR'S LIABILITY:
  56.  
  57.  In case of taking damage due to use, misuse or inability to use, this code,
  58.   whether it is physical damage to your hardware, loss of data or profits,
  59.   or any similar damages author shall not be liable for it. The whole risk is
  60.   with you.
  61.  
  62.  AUTHOR'S EXCLUSIVE RIGHTS:
  63.  
  64.  Author reserves the right to use this code in any commercial or non-
  65.   commercial software of his own design, the right to change the code partially
  66.   or in whole without notification to its users and the right to change its
  67.   status (to shareware, for example).
  68.  
  69.  How to contact author:
  70.  ~~~~~~~~~~~~~~~~~~~~~~
  71.  If you experiencing problems with this code or have any suggestions, bug
  72.   fixes or just wanna chat, refer to the following addresses:
  73.  
  74.   e-mail (preferrable):
  75.  
  76.   2:5028/52.6 (FIDOnet)
  77.   bob@ymz.yaroslavl.su (internet)
  78.  
  79.   paper mail:
  80.  
  81.   150031,
  82.   10/4/13 Dobrynina Str.,
  83.   Yaroslavl, 
  84.   Russia
  85.  
  86.   Vladimir M. Zakharychev (aka Bobby Z.)
  87.  
  88.   Letters both in Russian and in English are welcome. Please do not use any
  89.   other language if you want to be answered. Letter bombs are always
  90.   returned to sender... shhhh-boom-BANG! :)
  91.  
  92.   Thank you for your interest in B-coolWare products.
  93.  
  94.  ------------------------------------------------------------------------------
  95.  
  96.  Description.
  97.  ~~~~~~~~~~~~
  98.  This Borland Pascal unit was developed to give you the opportunity to improve
  99.  user interface of your DOS text mode applications written in Pascal by adding
  100.  "graphical" screen controls to your applications. The only implemented control
  101.  is "graphical" mouse pointer, but routines provided in this unit can also be
  102.  used to reprogram appearance of any characters. The unit supports both real
  103.  and protected modes and can be used with almost all TUI packages available for
  104.  Pascal programmers, which include Turbo Professional and Object Professional
  105.  by TurboPower Software, Turbo Vision 1.0 and 2.0 by Borland Intl. (with some
  106.  limitations described below) as well as other commercial or handmade tools.
  107.  
  108.  Actually this unit is a port from assembly language version 1.42 of g_Mouse
  109.  with simplified initialization. Version 1.42 did not support protected mode
  110.  because Borland's extender does not handle mouse function 14h (exchange
  111.  handlers) properly (this function was used to chain any existing handlers
  112.  to g_Mouse's one). Version 1.50.7 is compatible with RTM and uses only calls
  113.  proved to work correctly under it. And it is much easier to use.
  114.  
  115.  
  116.  Programmer's notes:
  117.  ~~~~~~~~~~~~~~~~~~~
  118.  
  119.   1. This code intercepts mouse services interrupt (33h) thus making
  120.      its use extremely easy: you just need to insert reference to g_Mouse in
  121.      "uses" clause of your application. Deinitialization of system is
  122.      performed automatically thru Pascal's ExitProc mechanism. All standard
  123.      mouse functions still work o.k. with this code with some exceptions in
  124.      protected mode which are due to RTM's limited support for those functions.
  125.  
  126.   2. If you wish to use this code within your Turbo Vision applications,
  127.      you'll have to change View.WriteView's logic in part determining if mouse
  128.      pointer is within area to be redrawn. Because now mouse pointer
  129.      occupies 4 characters instead of 1 it may happen that WriteView deter-
  130.      mine that mouse pointer is outside the area and do not hide it while
  131.      it actually should.
  132.      Also note that you should call DoneGMouse explicitly AFTER any call to
  133.      DoneEvents and resume g_Mouse operation by calling InitGMouse BEFORE
  134.      call to InitEvents. On program startup/exit it is done automatically but
  135.      when you do something weird like executing another process you should
  136.      shut down TV's managers first and then shut down g_Mouse. This makes
  137.      TV 2.0's TApplication.DOSShell unusable. You should always override it if
  138.      you intend to exec child processes from within your TV application using
  139.      TApplication.DOSShell method (see example program TUTOR01.PAS).
  140.   3. One conditional define affects the way code is compiled:
  141.  
  142.      TrackVideoMode
  143.  
  144.      If this is defined then mouse interrupt handler instantly calls INT 10h
  145.      function 0Fh (get current video mode) and suspends if current video mode
  146.      is other than 03h (80x25 color). Operation become a bit slower but you
  147.      won't get any probs when switching to other modes (80x50 for example).
  148.      You'll have to add other modes you want to support by yourself (like
  149.      SuperVGA 130xXX modes with 8x14 and 8x16 characters).
  150.  
  151.  
  152.  History:
  153.  ~~~~~~~~
  154.  
  155.    26 Oct 1994   ported and adapted assembly language version 1.42 to Pascal.
  156.          adapted for protected mode operation.
  157.  
  158. }
  159.  
  160. {$X+,G+,S-,P-,R-}
  161. {$C PRELOAD FIXED PERMANENT}
  162.  
  163. unit g_Mouse;
  164.  
  165. interface
  166.  
  167. type
  168.     CharMatrix = array[0..31] of Byte;
  169.  
  170. procedure InitGMouse( FlipMode : Boolean );
  171. { initialize g_Mouse system. FlipMode affects the movement of pointer. If
  172.   it is True, the pointer will move smooth, but characters will appear to
  173.   be somehow "wider" then usually. }
  174.  
  175. procedure DoneGMouse;
  176. { deinitialize g_Mouse system. Called automatically on program end, but you
  177.   will need to do it manually when executing child processes or something like
  178.   that. }
  179.  
  180. procedure SetMouseChars(C1Code, C2Code, C3Code, C4Code : Byte);
  181. { change characters used for mouse pointer. Note that these characters' maps
  182.   will be corrupted at runtime reflecting mouse movement. You should hide
  183.   mouse pointer before invoking this procedure. }
  184.  
  185. procedure SetPointerShape( var AND_Mask, OR_Mask );
  186. { used to change mouse pointer shape. AND_Mask and OR_Mask should be arrays of
  187.   at least CharSize bytes. }
  188.  
  189. procedure GetPointerShape( var AND_Mask, OR_Mask );
  190. { fills AND_Mask and OR_Mask arrays with current -and- and -or- masks that
  191.   represents mouse pointer. }
  192.  
  193. procedure GetCharMatrix( C : Word; var Matrix : CharMatrix);
  194. { returns bitmap for character C. If requested character is one of those used
  195.   to represent mouse pointer the Matrix will be filled with zeros. }
  196.  
  197. procedure SetCharMatrix( C : Word; var Matrix : CharMatrix);
  198. { sets character C's bitmap to Matrix. Unused scanlines should be zeroed. 
  199.   Does not change characters currently used to represent mouse pointer. }
  200.  
  201. const
  202.     Active   : Boolean = False;    { gMouse system is active }
  203.     CharSize : Word = 16;        { character height in scanlines }
  204.  
  205. implementation
  206.  
  207. uses Dos;
  208.  
  209. const
  210.     CurX     : Word = 0;        { current X position }
  211.     CurY     : Word = 0;        { current Y position }
  212.     C1Char   : Word = $DE;        { character to use as #1 }
  213.     C2Char   : Word = $DD;        { --"-- #2 }
  214.     C3Char   : Word = $D7;        { --"-- #3 }
  215.     C4Char   : Word = $D8;        { __"__ #4 }
  216.     C1       : array[1..16] of Byte = (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
  217.     C2       : array[1..16] of Byte = (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
  218.     C3       : array[1..16] of Byte = (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
  219.     C4       : array[1..16] of Byte = (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
  220.     Visible  : Boolean = False;    { mouse pointer is visible }
  221.     ModeFlip : Boolean = False;    { using 8 pixel-wide chars }
  222.         SaveBuf  : array[1..32] of Word = (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  223.                                            0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
  224.     OldChars : array[1..4] of Byte = (0,0,0,0);
  225.     OldPos   : Word = 0;
  226.     OldEvents: Word = 0;        { holds old event mask }
  227.  
  228.     OldHandler : Pointer = nil;    { holds address of old mouse handler }
  229.         i33Handler : Pointer = nil;    { holds address of INT 33 handler }
  230.         YSize    : Word = 394;        { Window max Y }
  231.         YMax     : Word = 394;        { Y max }
  232.         XSize    : Word = 638;        { Window max X }
  233.         XMin     : Word = 0;        { Window min X }
  234.         YMin     : Word = 0;        { Window min Y }
  235.  
  236.         ORMask   : array[1..16] of Byte =
  237.                    ($00,$40,$60,$70,$78,$7C,$7E,$7F,$7C,$4C,$0E,$06,$06,$00,$00,$00);
  238.  
  239.         ANDMask  : array[1..16] of Byte =
  240.                    ($3F,$1F,$0F,$07,$03,$01,$00,$00,$00,$01,$21,$F0,$F0,$F0,$FF,$FF);
  241.  
  242.  
  243. procedure Mode8BPC; near; assembler;
  244. { set 8 pixel-wide characters mode on VGA systems }
  245. asm
  246.     cli
  247.     mov    dx,3C4h
  248.     mov    al,1
  249.     out    dx,al
  250.     inc    dx
  251.     in    al,dx
  252.     or    al,1
  253.  
  254.     out    dx,al
  255.     mov    dx,3CCh
  256.     in    al,dx
  257.     and    al,0F3h
  258.  
  259.     mov    dx,3C2h
  260.     out    dx,al
  261.     mov    dx,3DAh
  262.     in    al,dx
  263.     mov    dx,3C0h
  264.     mov    al,13h
  265.     out    dx,al
  266.     sub    al,al
  267.     out    dx,al
  268.     mov    al,20h
  269.     out    dx,al
  270.     sti
  271.     mov    byte ptr C1Char,1
  272.     mov    byte ptr C2Char,2
  273.     mov    byte ptr C3Char,13
  274.     mov    byte ptr C4Char,10
  275. end;
  276.  
  277. procedure Mode9BPC; near; assembler;
  278. { set 9 pixel-wide character mode on VGA systems }
  279. asm
  280.     cli
  281.     mov    dx,3C4h
  282.     mov    al,1
  283.     out    dx,al
  284.     inc    dx
  285.     in    al,dx
  286.     and    al,0FEh
  287.     out    dx,al
  288.     mov    dx,3CCh
  289.     in    al,dx
  290.     and    al,0F3h
  291.     or    al,4
  292.     mov    dx,3C2h
  293.     out    dx,al
  294.     mov    dx,3DAh
  295.     in    al,dx
  296.     mov    dx,3C0h
  297.     mov    al,13h
  298.     out    dx,al
  299.     sub    al,al
  300.     dec    al
  301.     out    dx,al
  302.     mov    al,20h
  303.     out    dx,al
  304.     sti
  305. end;
  306.  
  307. procedure GetNewPos; near; forward;
  308. procedure gShowMouse; near; forward;
  309. procedure gHideMouse; near; forward;
  310.  
  311.  
  312. procedure MouseHandler; far; assembler;
  313. asm
  314.     push    seg @data
  315.     pop    ds
  316.     test    ax,1
  317.     jz    @@oldh
  318.     pusha
  319.     mov    al,Visible
  320.     push    ax
  321.     call    gHideMouse
  322.     call    GetNewPos
  323.     pop    ax
  324.     or    al,al
  325.     jz    @@2
  326.     call    gShowMouse
  327. @@2:
  328.     popa
  329. @@oldh:
  330.     push    ax
  331.     mov    ax,CurY
  332.     cwd
  333.     div    CharSize
  334.     shl    ax,3
  335.     mov    dx,ax
  336.     mov    cx,CurX
  337.     and    cl,0F8h
  338.     and    dl,0F8h
  339.     pop    ax
  340.     and    ax,OldEvents
  341.     jz    @@Q
  342.     push    si
  343.     mov    si, word ptr OldHandler
  344.     or    si, word ptr OldHandler[2]
  345.     pop    si
  346.     jz    @@Q
  347.     call    dword ptr ds:[OldHandler]
  348.     jmp    @@Q
  349.     db    13,10
  350.     db    'g_Mouse Interface  Version 1.50.7  Copyright(c) 1993,94 by B-coolWare.'
  351.     db    13,10
  352. @@Q:
  353. end;
  354.  
  355. procedure SetupRWMode; near; assembler;
  356. { set up character generator character map read/write mode }
  357. asm
  358.         push    ax
  359.         push    dx
  360.         mov     dx,3C4h
  361.         mov     ax,0402h
  362.         out     dx,ax
  363.         mov     ax,0704h
  364.         out     dx,ax
  365.         mov     dl,0CEh
  366.         mov     ax,0005h
  367.         out     dx,ax
  368.         mov     ax,0406h
  369.         out     dx,ax
  370.         mov     ax,0204h
  371.         out     dx,ax
  372.         pop     dx
  373.         pop     ax
  374. end;
  375.  
  376. procedure CloseRWMode; near; assembler;
  377. { reset video memory to normal text mode operation }
  378. asm
  379.         push    ax
  380.         push    dx
  381.         mov     dx,3C4h
  382.         mov     ax,0302h
  383.         out     dx,ax
  384.         mov     ax,0304h
  385.         out     dx,ax
  386.         mov     dl,0CEh
  387.         mov     ax,1005h
  388.         out     dx,ax
  389.         mov     ax,0E06h
  390.         out     dx,ax
  391.         mov     ax,0004h
  392.         out     dx,ax
  393.         pop     dx
  394.         pop     ax
  395. end;
  396.  
  397. procedure MoveChar; near; assembler;
  398. { copy cx words to/from video memory }
  399. asm
  400.         call    SetupRWMode
  401.         rep     movsw
  402.         call    CloseRWMode
  403. end;
  404.  
  405. procedure LoadChar; near; assembler;
  406. { read character map from video memory }
  407. asm
  408.         push    cx
  409.         shl     si,5
  410.         call    MoveChar
  411.         pop     cx
  412. end;
  413.  
  414. procedure SaveChar; near; assembler;
  415. { write character map to video memory }
  416. asm
  417.         push    cx
  418.         shl     di,5
  419.         call    MoveChar
  420.         pop     cx
  421. end;
  422.  
  423. procedure LoadChars( Ch1, Ch2, Ch3, Ch4 : Word ); near; assembler;
  424. { read our four character maps from video memory }
  425. asm
  426.     push    ds
  427.  
  428.         push    ds
  429.         pop     es
  430.  
  431.         mov     cx,CharSize
  432.         shr     cx,1
  433.         push    SegA000
  434.         pop     ds
  435.  
  436.     cld
  437.  
  438.         mov     di,offset C1
  439.         mov     si,Ch1
  440.         call    LoadChar
  441.  
  442.         mov     di,offset C2
  443.         mov     si,Ch2
  444.         call    LoadChar
  445.  
  446.         mov     di,offset C3
  447.         mov     si,Ch3
  448.         call    LoadChar
  449.  
  450.         mov     di,offset C4
  451.         mov     si,Ch4
  452.         call    LoadChar
  453.  
  454.     pop    ds
  455. end;
  456.  
  457. procedure SaveChars( Ch1, Ch2, Ch3, Ch4 : Word ); near; assembler;
  458. { store our character maps in video memory }
  459. asm
  460.         push    ds
  461.  
  462.         mov     cx,CharSize
  463.         shr     cx,1
  464.         push    SegA000
  465.         pop     es
  466.     
  467.     cld
  468.  
  469.         mov     si,offset C1
  470.         mov     di,Ch1
  471.         call    SaveChar
  472.  
  473.         mov     si,offset C2
  474.         mov     di,Ch2
  475.         call    SaveChar
  476.  
  477.         mov     si,offset C3
  478.         mov     di,Ch3
  479.         call    SaveChar
  480.  
  481.         mov     si,offset C4
  482.         mov     di,Ch4
  483.         call    SaveChar
  484.  
  485.         pop     ds
  486. end;
  487.  
  488. procedure computeOffset; near; assembler;
  489. { computes offset of character at (CurX,CurY) in video buffer }
  490. asm
  491.     push    ax
  492.         push    bx
  493.         push    dx
  494.     mov    si,CurX
  495.     shr    si,2
  496.     mov    ax,CurY
  497.     cwd
  498.     mov    bx,CharSize
  499.     div    bx
  500.     mov    bl,160
  501.     mul    bl
  502.     add    si,ax
  503.     and    si,0FFFEh
  504.     pop    dx
  505.         pop     bx
  506.         pop     ax
  507. end;
  508.  
  509. procedure UpdateChars; near; assembler;
  510. { applies -and- and -or- masks on characters behind cursor to make it visible }
  511. asm
  512.     call    computeOffset
  513.     push    SegB800
  514.     pop    es
  515.     sub    ah,ah
  516.     mov    al,es:[si]
  517.     push    ax
  518.     mov    al,es:[si+2]
  519.     push    ax
  520.     mov    al,es:[si+160]
  521.     push    ax
  522.     mov    al,es:[si+162]
  523.     push    ax
  524.     call    LoadChars
  525.     mov    cx,CurX
  526.     mov    bx,CurY
  527.     and    cx,7
  528.     mov    ax,CharSize
  529.     dec    ax
  530.     and    bx,ax
  531.     sub    si,si
  532. @@1:
  533.     cmp    bx,CharSize
  534.     jz    @@2
  535.     mov    ah, byte ptr C1[bx]
  536.     mov    al, byte ptr C2[bx]
  537.     mov    dh, byte ptr ANDMask[si]
  538.     mov    dl,0FFh
  539.     ror    dx,cl
  540.     and    ax,dx
  541.     mov    dh, byte ptr ORMask[si]
  542.     sub    dl,dl
  543.     shr    dx,cl
  544.     or    ax,dx
  545.     mov    byte ptr C1[bx],ah
  546.     mov    byte ptr C2[bx],al
  547.     inc    bx
  548.     inc    si
  549.     cmp    si,CharSize
  550.     jb    @@1
  551.     jmp    @@3
  552. @@2:
  553.     sub    bx,bx
  554. @@4:
  555.     mov    ah,byte ptr C3[bx]
  556.     mov    al,byte ptr C4[bx]
  557.     mov    dh,byte ptr ANDMask[si]
  558.     mov    dl,0FFh
  559.     ror    dx,cl
  560.     and    ax,dx
  561.     mov    dh,byte ptr ORMask[si]
  562.     sub    dl,dl
  563.     shr    dx,cl
  564.     or    ax,dx
  565.     mov    byte ptr C3[bx],ah
  566.     mov    byte ptr C4[bx],al
  567.     inc    bx
  568.     inc    si
  569.     cmp    si,CharSize
  570.     jb    @@4
  571. @@3:
  572.     push    C1Char
  573.     push    C2Char
  574.     push    C3Char
  575.     push    C4Char
  576.     call    SaveChars
  577. end;
  578.  
  579. procedure GetNewPos; assembler;
  580. { get new pointer position in mickeys (we using them instead of pixels) }
  581. asm
  582.     mov    ax,0Bh
  583.     int    33h
  584.     add    CurX,cx
  585.     add    CurY,dx
  586.     mov    ax,CurX
  587.         or      ax,ax
  588.         js      @@6
  589.     cmp    ax,XMin
  590.     jnb    @@1
  591. @@6:
  592.     mov    ax,XMin
  593.     jmp    @@2
  594. @@1:
  595.     cmp    ax,XSize
  596.     jbe    @@2
  597.     mov    ax,XSize
  598. @@2:
  599.     mov    CurX,ax
  600.     mov    ax,CurY
  601.         or      ax,ax
  602.         js      @@5
  603.     cmp    ax,YMin
  604.     jnb    @@3
  605. @@5:
  606.     mov    ax,YMin
  607.     jmp    @@4
  608. @@3:
  609.     cmp    ax,YSize
  610.     jbe    @@4
  611.     mov    ax,YSize
  612. @@4:
  613.     mov    CurY,ax
  614. end;
  615.  
  616. procedure gShowMouse; assembler;
  617. { show mouse pointer }
  618. asm
  619.     cmp    Active,0
  620.     jz    @@Q
  621.     cmp    Visible,1
  622.     jz    @@Q
  623.     push    ax
  624.         push    si
  625.         push    es
  626.     call    computeOffset
  627.     mov    OldPos,si
  628.     push    SegB800
  629.     pop    es
  630.     mov    al,es:[si]
  631.     mov    byte ptr OldChars,al
  632.     mov    al,es:[si+2]
  633.     mov    byte ptr OldChars[1],al
  634.     mov    al,es:[si+160]
  635.     mov    byte ptr OldChars[2],al
  636.     mov    al,es:[si+162]
  637.     mov    byte ptr OldChars[3],al
  638.     push    es
  639.         push    si
  640.     call    UpdateChars
  641.     pop    si
  642.         pop     es
  643.     mov    al,byte ptr C1Char
  644.     mov    ah,byte ptr C3Char
  645.     mov    es:[si],al
  646.     mov    es:[si+160],ah
  647.     cmp    CurX,632
  648.     jae    @@10        { oops! wrapping may occur }
  649.     mov    al,byte ptr C2Char
  650.     mov    ah,byte ptr C4Char
  651.     mov    es:[si+2],al
  652.     mov    es:[si+162],ah
  653. @@10:
  654.     pop    es
  655.         pop     si
  656.         pop     ax
  657.     mov    Visible,1
  658. @@Q:
  659. end;
  660.  
  661. procedure gHideMouse; assembler;
  662. { hide mouse pointer }
  663. asm
  664.     cmp    Active,0
  665.     jz    @@Q
  666.     cmp    Visible,0
  667.     jz    @@Q
  668.     push    ax
  669.         push    es
  670.         push    di
  671.     mov    di,OldPos
  672.     push    SegB800
  673.     pop    es
  674.     mov    al,byte ptr OldChars
  675.     mov    es:[di],al
  676.     mov    al,byte ptr OldChars[1]
  677.     mov    es:[di+2],al
  678.     mov    al,byte ptr OldChars[2]
  679.     mov    es:[di+160],al
  680.     mov    al,byte ptr OldChars[3]
  681.     mov    es:[di+162],al
  682.     pop    di
  683.         pop     es
  684.         pop     ax
  685.     mov    Visible,0
  686. @@Q:
  687. end;
  688.  
  689. function isVGAble : Boolean; near; assembler;
  690. { check whether current video adapter a VGA/EGA }
  691. asm
  692.     mov    ax,1A00h
  693.     int    10h
  694.     cmp    al,1Ah
  695.     jz    @@Ok
  696.     push    es        { still keeping compatibility with EGA systems }
  697.     push    Seg0040        { though they're very rare now... }
  698.     pop    es
  699.     mov    al,es:[87h]
  700.     pop    es
  701.     or    al,al
  702.     jz    @@Fail        { this is even not EGA! }
  703.     mov    CharSize,14    { EGA's text display is 640x350 pixels, }
  704.     mov    YSize,344    { characters are 14 lines high }
  705.         mov     YMax,344
  706. @@Ok:
  707.     mov    ah,0Fh        { video mode is 80x25? }
  708.     int    10h
  709.     cmp    al,3
  710.     jnz    @@Fail        { no - do not initialize }
  711.     mov     al,1
  712.         jmp     @@Q
  713. @@Fail:
  714.     sub     al,al
  715. @@Q:
  716. end;
  717.  
  718. procedure MouseInt; assembler;
  719. asm
  720.         push    ds
  721.         push    seg @data
  722.         pop     ds
  723. {$IFDEF TrackVideoMode }
  724.     push    ax
  725.     mov    ah,0Fh
  726.     push    bp
  727.     push    es
  728.     int    10h
  729.     cli        { interrupts gets enabled at this point }
  730.     pop    es
  731.     pop    bp
  732.     cmp    al,3
  733.     pop    ax
  734.     jnz    @@JOld
  735. {$ENDIF}
  736.     cmp    Active,0
  737.     jz    @@JOld
  738.     cmp    ax,1    { show mouse pointer }
  739.     jz    @@1
  740.     cmp    ax,2    { hide mouse pointer }
  741.     jz    @@2
  742.     cmp    ax,3    { get current pointer coordinates (in pixels) }
  743.     jz    @@3
  744.     cmp    ax,4    { set current pointer coordinates }
  745.     jz    @@4
  746.     cmp    ax,7    { set horizontal clipping boundaries }
  747.     jz    @@7
  748.     cmp    ax,8    { set vertical clipping boundaries }
  749.     jz    @@8
  750.     cmp    ax,0Ch    { set new event handler }
  751.     jz    @@0C
  752.     cmp    ax,14h    { exchange handlers - doesn't work in PM }
  753.     jz    @@14
  754.  
  755.     { set mouse+key handler, get mouse+key handler and other functions are
  756.           not intercepted for they are used very rarely. }
  757. @@JOld:
  758.  
  759.        (* because in PM we can't write to code segment without getting code
  760.           segment alias, I do not use here more convenient way to chain to
  761.           previous interrupt handler:
  762.  
  763.       DB    0EAh    { far jump [immediate] opcode }
  764.       DD    SaveIntVector
  765.  
  766.       because it leads to some difficulties in PM. Usually in Pascal I
  767.           do it this way:
  768.  
  769.       Because there is no way in pascal to make SaveIntVector global, I
  770.       add one function to handle, which takes one parameter - dword to
  771.       write to SaveIntVector and do an explicit call to handler with
  772.       value of current interrupt vector somewhere on program startup.
  773.        *)
  774.  
  775.     pushf
  776.     call    dword ptr [i33Handler]
  777.     pop    ds
  778.     iret
  779. @@1:
  780.     call    gShowMouse
  781.     jmp     @@out
  782. @@2:
  783.     call    gHideMouse
  784.     jmp     @@out
  785. @@3:
  786.  
  787.     pushf
  788.     call    dword ptr [i33Handler] { simulating interrupt }
  789.     push    ax
  790.     mov    ax,CurY        { substituting mouse driver's coordinates with
  791.                   ours }
  792.     cwd
  793.     div    CharSize
  794.     shl    ax,3
  795.     mov    cx,CurX
  796.     mov    dx,ax
  797.     and    cl,0F8h
  798.     and    dl,0F8h
  799.     pop    ax
  800.     jmp     @@out
  801. @@4:
  802.     mov    CurX,cx
  803.     push    dx
  804.     shr    dx,3
  805.     push    ax
  806.     mov    ax,dx
  807.     mul    byte ptr CharSize
  808.     mov    CurY,ax
  809.     pop    ax
  810.     pop    dx
  811.     jmp     @@out
  812. @@7:
  813.     mov    XMin,cx
  814.     cmp    dx,638
  815.     jb    @@71
  816.     mov    dx,638
  817. @@71:
  818.     mov    XSize,dx
  819.     jmp     @@out
  820. @@8:
  821.     push    ax
  822.     mov    ax,cx
  823.     shr    ax,3
  824.     mul    byte ptr CharSize
  825.     mov    YMin,ax
  826.     mov    ax,dx
  827.     shr    ax,3
  828.     mul    byte ptr CharSize
  829.     cmp    ax,YMax
  830.     jae    @@81
  831.     push    ax
  832.     add    ax,16
  833.     cmp    ax,YMax
  834.     pop    ax
  835.     jae    @@81
  836.     mov    YSize,ax
  837. @@81:
  838.     pop    ax
  839.     jmp     @@out
  840. @@0C:
  841.     mov    word ptr OldEvents,cx        { setting new handler address }
  842.     mov    word ptr OldHandler,dx        { we'll chain to }
  843.     mov    word ptr OldHandler[2],es
  844.     jmp     @@out
  845. @@14:
  846.     push    ax
  847.     xchg    cx,OldEvents
  848.     xchg    word ptr OldHandler,dx
  849.     mov    ax,es
  850.     xchg    word ptr OldHandler[2],ax
  851.     mov    es,ax
  852.     pop    ax
  853. @@out:
  854.         pop     ds
  855.         iret
  856. end;
  857.  
  858. procedure InitGMouse;
  859. { initialize graphical mouse pointer system }
  860. label Failed;
  861.  begin
  862.   if Active then
  863.    DoneGMouse;
  864.   asm
  865.     { check if mouse driver present and is operatable }
  866.     mov    ax,3533h
  867.     int    21h
  868.     mov    ax,es
  869.     or    ax,bx
  870.     jz    Failed
  871.     sub    ax,ax
  872.     int    33h
  873.     or    ax,ax
  874.     jz    Failed
  875.   end;
  876.   if not isVGAble then
  877.  Failed:
  878.    exit;
  879.   if FlipMode then
  880.    Mode8BPC;
  881.   ModeFlip := FlipMode;
  882.   LoadChars(C1Char, C2Char, C3Char, C4Char);
  883.   Move(C1,SaveBuf,sizeof(SaveBuf));
  884.   asm
  885.     mov    ax,0Ch
  886.     push    cs
  887.     pop    es
  888.     mov    dx,offset MouseHandler
  889.     mov    cx,7Fh
  890.     int    33h
  891.   end;
  892.   GetIntVec($33,i33Handler);
  893.   SetIntVec($33,@MouseInt);
  894.   Active := True;
  895.  end;
  896.  
  897. procedure DoneGMouse;
  898. { deinitialize graphical mouse pointer system }
  899.  begin
  900.   if not Active then
  901.    exit;
  902.   SetIntVec($33,i33Handler);
  903.   gHideMouse;
  904.   Move(SaveBuf,C1,sizeof(SaveBuf));
  905.   SaveChars(C1Char, C2Char, C3Char, C4Char);
  906.   if ModeFlip then
  907.    Mode9BPC;
  908.   asm
  909.     mov    ax,0Ch
  910.     mov    cx,[OldEvents]
  911.     mov    dx,word ptr [OldHandler][2]
  912.     mov    es,dx
  913.     mov    dx,word ptr [OldHandler]
  914.     int    33h
  915.   end;
  916.   C1Char := $DE;
  917.   C2Char := $DD;
  918.   C3Char := $D7;
  919.   C4Char := $D8;
  920.   Active := False;
  921.  end;
  922.  
  923. procedure SetMouseChars;
  924.  begin
  925.   if Active then
  926.    begin
  927.     Move(SaveBuf,C1,sizeof(SaveBuf));
  928.     SaveChars(C1Char, C2Char, C3Char, C4Char);
  929.    end;
  930.   C1Char := C1Code;
  931.   C2Char := C2Code;
  932.   C3Char := C3Code;
  933.   C4Char := C4Code;
  934.   if Active then
  935.    begin
  936.     LoadChars(C1Char, C2Char, C3Char, C4Char);
  937.     Move(C1,SaveBuf,sizeof(SaveBuf));
  938.    end;
  939.  end;
  940.  
  941.  
  942. procedure GetPointerShape;
  943.  begin
  944.   Move(ANDMask, AND_Mask, CharSize);
  945.   Move(ORMask, OR_Mask, CharSize);
  946.  end;
  947.  
  948. procedure SetPointerShape;
  949.  var SVisible : Boolean;
  950.  begin
  951.   SVisible := Visible;
  952.   if Active then
  953.    gHideMouse;
  954.   Move(AND_Mask, ANDMask, CharSize);
  955.   Move(OR_Mask,ORMask, CharSize);
  956.   if Active and SVisible then
  957.    gShowMouse;
  958.  end;
  959.  
  960. procedure GetCharMatrix; assembler;
  961. asm
  962.     mov    si,C
  963.     cmp    si,C1Char
  964.     jz    @@fill0
  965.     cmp    si,C2Char
  966.     jz    @@fill0
  967.     cmp    si,C3Char
  968.     jz    @@fill0
  969.     cmp    si,C4Char
  970.     jz    @@fill0
  971.     shl    si,5
  972.     mov    cx,16
  973.     push    ds
  974.     push    SegA000
  975.     pop    ds
  976.     les    di,Matrix
  977.     cld
  978.     call    MoveChar
  979.     pop    ds
  980.     jmp    @@Q
  981. @@fill0:
  982.     cld
  983.     les    di,Matrix
  984.     sub    ax,ax
  985.     mov    cx,16
  986.     rep    stosw
  987. @@Q:
  988. end;
  989.  
  990. procedure SetCharMatrix; assembler;
  991. asm
  992.     mov    al,Visible
  993.     push    ax
  994.     cmp    Active,0
  995.     jz    @@1
  996.     call    gHideMouse
  997. @@1:
  998.     mov    di,C
  999.     cmp    di,C1Char
  1000.     jz    @@skip
  1001.     cmp    di,C2Char
  1002.     jz    @@skip
  1003.     cmp    di,C3Char
  1004.     jz    @@skip
  1005.     cmp    di,C4Char
  1006.     jz    @@skip
  1007.     shl    di,5
  1008.     mov    cx,16
  1009.     push    SegA000
  1010.     pop    es
  1011.     push    ds
  1012.     lds    si,Matrix
  1013.     cld
  1014.     call    MoveChar
  1015.     pop    ds
  1016. @@skip:
  1017.     pop    ax
  1018.     or    al,al
  1019.     jz    @@Q
  1020.     cmp    Active,0
  1021.     jz    @@Q
  1022.     call    gShowMouse
  1023. @@Q:
  1024. end;
  1025.  
  1026. const
  1027.  
  1028.      OldExitProc : Pointer = nil;
  1029.  
  1030. procedure gMouseExitProc; far;
  1031.  begin
  1032.   ExitProc := OldExitProc;
  1033.   DoneGMouse;
  1034.  end;
  1035.  
  1036. begin
  1037.  OldExitProc := ExitProc;
  1038.  ExitProc := @gMouseExitProc;
  1039.  InitGMouse(True);
  1040. end.
  1041.